home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / self-mode / self.el < prev   
Encoding:
Text File  |  1993-07-25  |  5.1 KB  |  143 lines
  1. ;; Inferior self mode
  2. ;;
  3. ;; For running a Self interpreter under Emacs.
  4. ;; Hacked my Michael Richardson <mcr@physics.carleton.ca>
  5. ;; Requires associated self-mode.el to be on your library path.
  6. ;;
  7. ;; This code based very strongly in the inferior lisp mode
  8. ;; found in shell.el
  9. ;;
  10.  
  11. ;
  12. ; $Id: self.el,v 1.2 1993/05/14 21:45:01 richards Exp $
  13. ;
  14. ; $Log: self.el,v $
  15. ; Revision 1.2  1993/05/14  21:45:01  richards
  16. ; self-send-object doesn't always work quite right if you are at the
  17. ; very beginning of the object. Fixed it to go the beginning first.
  18. ;
  19. ; Revision 1.1  1993/05/14  21:12:11  richards
  20. ; Initial revision
  21. ;
  22. ;
  23.  
  24. (require 'shell)
  25. (load-library "self-mode")
  26.  
  27. (defvar inferior-self-mode-map nil)
  28.  
  29. (if inferior-self-mode-map
  30.     nil
  31.   (progn 
  32.     (setq inferior-self-mode-map (copy-alist shell-mode-map))
  33.     (self-mode-commands inferior-self-mode-map)
  34.     (define-key inferior-self-mode-map "\e\C-x" 'self-send-object)))
  35.  
  36. (defvar inferior-self-program "Self"
  37.   "*Program name for invoking an inferior Self with `run-self'. You might want to set this your favorite Snapshot, or set this variable in an Emacs file variable.")
  38.  
  39. (defvar inferior-self-load-command "'%s' _RunScript\n"
  40.   "*Format-string for building a Self expression to load a file.
  41. This format string should use %s to substitute a file name
  42. and should result in a Self expression that will command the inferior Self
  43. to load that file.  ")
  44.  
  45. (defvar inferior-self-prompt "^.*>"
  46.   "*Regexp to recognize prompts from the inferior Self.")
  47.  
  48. (defun inferior-self-mode ()
  49.   "Major mode for interacting with an inferior Self process.
  50. Runs a Self interpreter as a subprocess of Emacs, with Self I/O
  51. through an Emacs buffer.  Variable inferior-self-program controls
  52. which Self interpreter is run.  Variables inferior-self-prompt
  53. and inferior-self-load-command can customize this mode for different
  54. Self interpreters.
  55.  
  56. Commands:
  57. DELETE converts tabs to spaces as it moves back.
  58. TAB indents for Self; with argument, shifts rest
  59.  of expression rigidly with the current line.
  60. Meta-Control-Q does TAB on each line starting within following expression.
  61. Paragraphs are separated only by blank lines.  Semicolons start comments.
  62.  
  63. Return at end of buffer sends line as input.
  64. Return not at end copies rest of line to end and sends it.
  65.  
  66. The following commands imitate the usual Unix interrupt and
  67. editing control characters:
  68. \\{shell-mode-map}
  69.  
  70. Entry to this mode calls the value of self-mode-hook with no arguments,
  71. if that value is non-nil.  Likewise with the value of shell-mode-hook.
  72. self-mode-hook is called after shell-mode-hook.
  73.  
  74. You can send text to the inferior Self from other buffers
  75. using the commands process-send-region, process-send-string
  76. and \\[self-send-object]."
  77.   (interactive)
  78.   (kill-all-local-variables)
  79.   (setq major-mode 'inferior-self-mode)
  80.   (setq mode-name "Inferior Self")
  81.   (setq mode-line-process '(": %s"))
  82.   (use-local-map inferior-self-mode-map)
  83.   (make-local-variable 'last-input-start)
  84.   (setq last-input-start (make-marker))
  85.   (make-local-variable 'last-input-end)
  86.   (setq last-input-end (make-marker))
  87.   (self-mode-variables)
  88.   (run-hooks 'shell-mode-hook 'self-mode-hook 'inferior-self-mode-hook))
  89.  
  90. (defun run-self ()
  91.   "Run an inferior Self process, input and output via buffer *self*."
  92.   (interactive)
  93.   (switch-to-buffer (make-shell "self" inferior-self-program))
  94.   (cd (getenv "SELF_WORKING_DIR"))  ; do this so the user knows where
  95.                                     ; the Self is rooted. BUT! Beware, this
  96.                                     ; likely is NOT where the snapshot was.
  97.   (inferior-self-mode))
  98.  
  99. (defun self-send-object (display-flag)
  100.   "Send the current object to the Self process made by M-x run-self.
  101. With argument, force redisplay and scrolling of the *self* buffer.
  102. Variable `inferior-self-load-command' controls formatting of
  103. the `load' form that is set to the Self process."
  104.   (interactive "P")
  105.   (or (get-process "self")
  106.       (error "No current self process"))
  107.   (save-excursion
  108.    (beginning-of-object)
  109.    (let ((begin (point))
  110.      (filename (format "/tmp/emself%d" (process-id (get-process "self")))))
  111.      (end-of-object)
  112.      (if (= begin (point))
  113.      (message "Empty area. Please move inside object you want to send.")
  114.        (progn 
  115.      (write-region begin (point) filename nil 'nomessage)
  116.      (process-send-string "self" (format inferior-self-load-command filename)))))
  117.    (if display-flag
  118.        (let* ((process (get-process "self"))
  119.           (buffer (process-buffer process))
  120.           (w (or (get-buffer-window buffer) (display-buffer buffer)))
  121.           (height (window-height w))
  122.           (end))
  123.      (save-excursion
  124.        (set-buffer buffer)
  125.        (setq end (point-max))
  126.        (while (progn
  127.             (accept-process-output process)
  128.             (goto-char (point-max))
  129.             (beginning-of-line)
  130.             (or (= (point-max) end)
  131.             (not (looking-at inferior-self-prompt)))))
  132.        (setq end (point-max))
  133.        (vertical-motion (- 4 height))
  134.        (set-window-start w (point)))
  135.      (set-window-point w end)))))
  136. ;  (message "Object sent."))
  137.  
  138. (defun self-send-object-and-go ()
  139.   "Send the current object to the inferior Self, and switch to *self* buffer."
  140.   (interactive)
  141.   (self-send-object nil)
  142.   (switch-to-buffer "*self*"))
  143.